perm filename PERM[1,JMC] blob sn#005211 filedate 1969-10-15 generic text, type T, neo UTF8
00100	(DE MA (CYC D) (COND ((NULL CYC) D) (T (MA1 (CAR CYC) 
00200	CYC D))))
00300	
00400	(DE MA1 (X U D) (COND ((NULL U) D) ((EQUAL (CAR U) D)
00500	(COND ((NULL (CDR U)) X) (T (CADR U)))) (T (MA1 X (CDR
00600	 U) D))))
00700	
00800	(DE MB (PERM D) (COND ((NULL PERM) D) (T (MA (CAR PERM)
00900	(MB (CDR PERM) D)))))
01000	
01100	(DE UNION (U V) (COND ((NULL U) V) ((MEMBER (CAR U) V)
01200	(UNION (CDR U) V)) (T (CONS (CAR U) (UNION (CDR U) V)))))
01300	
01400	(DE DIGS (P V) (COND ((NULL P) V) (T (DIGS (CDR P)
01500	 (UNION (CAR P) V)))))
01600	
01700	(DE PRODA (P1 P2) (PA (APPEND P1 P2) (DIGS P2 (DIGS P1 
01800	 NIL))))
01900	
02000	(DE PA (U V) (COND ((NULL V) NIL) (T ((LAMBDA (W) 
02100	(COND ((NULL W) (PA U (CDR V))) (T (CONS W (PA U (SSUB V W))))))
02200	(PB (CAR V) U)))))
02300	
02400	(DE PB (X U) ((LAMBDA (Y) (COND ((EQUAL Y X) NIL)
02500	(T (CONS X (PC X Y U))))) (MB U X)))
02600	
02700	(DE PC (X Y U) (COND ((EQUAL Y X) NIL) (T (CONS Y 
03100	(PC X (MB U Y) U)))))
03200	
03300	(DE SSUB (X Y) (COND ((NULL X) NIL) ((MEMBER (CAR X) Y)
03400	 (SSUB (CDR X) Y)) (T (CONS (CAR X) (SSUB (CDR X) Y)))))
03500	
03600	(DE PROD (P1 P2) ((LAMBDA (W) (COND ((NULL W) NIL)
03700	((NULL (CDR W)) (CAR W)) (T W))) (PRODA (PRODB P1) (PRODB P2))))
03800	
03900	(DE PRODB (P) (COND ((NULL P) NIL) ((ATOM (CAR P))
04000	(LIST P)) (T P)))
04100	
04200	(DE INV (P) (COND ((NULL P) NIL) 
04300	((ATOM (CAR P)) (REVERSE P))
04400	(T (MAPLIST (FUNCTION (LAMBDA (X)
04500	(REVERSE (CAR X)))) P))))
04600	
04700	(DE SPRODA (U V Y) (COND ((NULL U) Y)
04800	(T (SPRODA (CDR U) V (SPRODB (CAR U) V Y)))))
04900	
05000	(DE SPRODB (X V Y) (COND ((NULL V) Y) 
05100	(T (SPRODB X (CDR V) (CONS (PROD X (CAR V)) Y)))))
05200	
05300	(DE RA (U V) (COND ((NULL U) V) (T (RA (CDR U)
05400	(CONS (CAR U) V)))))
05500	
05600	(DE ROT (W) (COND ((OR (NULL W) (NULL (CDR W))) W)
05700	(T (ROTA (CAR W) (LIST (CAR W)) NIL (CDR W)))))
05800	
05900	(DE ROTA (X U V W) (COND ((NULL W) (RA U (RA V NIL)))
06000	((LESSP X (CAR W)) (ROTA X (CONS (CAR W) U) V (CDR W)))
06100	(T (ROTA (CAR W) (LIST (CAR W)) (APPEND U V) (CDR W)))))